#!/usr/bin/perl -c

package namespace::globref;

=head1 NAME

namespace::globref - Keep package's namespace clean

=head1 SYNOPSIS

  package My::Class;

  # import some subroutine
  use Scalar::Util 'looks_like_number';

  # change it into coderef constant
  use namespace::globref;

  # our subroutine uses coderef
  sub is_num {
      my ($self, $val) = @_;
      return looks_like_number->("$val");
  }

  # remove all previously created coderefs
  no namespace::globref;

  # our package doesn't provide imported subroutine anymore!

=head1 DESCRIPTION

This pragma allows to convert all subroutines existing in package's
namespace into code references and finally it removes them.

The problem is that any subroutine which is imported to your
package, stays a part of public API of this package. I.e.:

  package My::PollutedClass;
  use Scalar::Util 'looks_like_number';

  package main;
  print My::PollutedClass->can('looks_like_number');  # true

Undefining imported subroutines is not a solution, because the
subroutine will be not available at run-time:

  package My::PoorSolutionClass;
  use Scalar::Util 'looks_like_number';

  sub is_num {
      my ($val) = @_;
      return looks_like_number("$val");
  }

  undef *looks_like_number;

  package main;
  print My::PoorSolutionClass::is_num(42);  # error!

Using of fully qualified subroutine names (with package) is not a
solution, because it doesn't work with L<Sub::Exporter> and
probably other exporting mechanisms.

=for readme stop

=cut


use 5.006;

use strict;
use warnings;

our $VERSION = '0.01';


use Carp ();
use Symbol::Util ();

use Smart::Comments;


# Convert subroutines into coderefs
sub import {
    my (undef, @subroutines) = @_;
    my $caller = caller;

    my $tmp = __PACKAGE__ . "::tmp::$caller";

    no warnings 'once';
    @subroutines = grep { defined *{ Symbol::Util::fetch_glob("${caller}::$_") }{CODE} }
                   keys %{ Symbol::Util::stash($caller) }
        if not @subroutines;

    foreach my $subroutine (@subroutines) {
        Carp::carp("Undefined subroutine \&${caller}::$subroutine imported")
            if not defined *{ Symbol::Util::fetch_glob("${caller}::$subroutine") }{CODE};

        # backup into temporary namespace
        *{ Symbol::Util::fetch_glob("${tmp}::$subroutine") }
            = *{ Symbol::Util::fetch_glob("${caller}::$subroutine") }{CODE};

        # delete subroutine
        Symbol::Util::delete_glob("${caller}::$subroutine", 'CODE');

        # define new coderef constant
        my $coderef = *{ Symbol::Util::fetch_glob("${tmp}::$subroutine") }{CODE};
        *{ Symbol::Util::fetch_glob("${caller}::$subroutine") }
            = sub () { $coderef };
    };
};


# Remove coderefs
sub unimport {
    my (undef, @subroutines) = @_;
    my $caller = caller;

    my $delete_package;
    my $tmp = __PACKAGE__ . "::tmp::$caller";

    no warnings 'once';
    @subroutines = grep { defined *{ Symbol::Util::fetch_glob("${tmp}::$_") }{CODE} }
                   keys %{ Symbol::Util::stash($tmp) }
        if not @subroutines;

    foreach my $subroutine (@subroutines) {
        Carp::carp("Undefined subroutine \&${caller}::$subroutine unimported")
            if not defined *{ Symbol::Util::fetch_glob("${tmp}::$subroutine") }{CODE};

        # delete globref and subroutine
        Symbol::Util::delete_glob("${caller}::$subroutine", 'CODE');
        Symbol::Util::delete_glob("${tmp}::$subroutine", 'CODE');
    };
};


1;


__END__

=head1 IMPORTS

=over

=item use namespace::globref;

Converts all subroutines in our namespace.

=item use namespace::globref 'func1', 'func2';

Converts listed subroutine only.

=item no namespace::globref;

Removes all coderefs from our namespace.

=item use namespace::globref 'func1', 'func2';

Removes listed coderefs only.

=back

=head1 OVERVIEW

This pragma needs to be placed in the right order: after last C<use> which
imports some subroutines and before first C<sub>.

  package My::Example;

  use Carp 'confess';
  use Scalar::Util 'blessed'

  use namespace::globref;

  sub some_method {
      my ($self) = @_;
      confess->("Call as a method") if not blessed->($self);
      # ...
  };

  no namespace::globref;

The coderefs require different syntax and doesn't support prototypes.

  use Carp 'confess';

  confess "Boom!";

  use namespace::globrefs;

  confess->("Boom!");

You can check if your package is clean with L<Class::Inspector> module and
its methods: C<functions> and C<methods>.

  use My::Example;
  use Class::Inspector;
  use YAML;
  print Dump ( {
        functions => [Class::Inspector->functions("My::Example")],
        methods   => [Class::Inspector->methods("My::Example")],
  } );

=head2 Moose

L<Moose> keywords can be unexported with C<no Moose> statement.  Even that,
L<Moose> imports following subroutines: C<blessed>, C<confess>, C<meta>.  The
C<meta> method is required by Moose framework and should be unchanged.  The
others can be converted into coderefs explicitly.

  package My::MooseClass;

  use Scalar::Util 'reftype';

  use namespace::globref;

  use Moose;

  use namespace::globref 'blessed', 'confess';

  sub my_method {
      my ($self) = @_;
      ...
  };

  no Moose;

  no namespace::globref;

  # The My::MooseClass now provides "my_method" and "meta" only.

=head1 SEE ALSO

L<namespace::clean>, L<Class::Inspector>.

=head1 BUGS

If you find the bug, please report it.

=for readme continue

=head1 AUTHOR

Piotr Roszatycki <dexter@debian.org>

=head1 COPYRIGHT

Copyright (C) 2009 by Piotr Roszatycki E<lt>dexter@debian.orgE<gt>.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>
